home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Applications / NIH Image 1.62b11 / Macros / Input⁄Output Macros < prev    next >
Text File  |  1996-05-30  |  16KB  |  643 lines
  1. var
  2.   CharLoc:integer; {Global variable, initially zero}
  3.  
  4. macro 'Save using Time as Name…';
  5. {Note: Colons are not allowed in file names.}
  6. var
  7.   year,month,day,hour,minute,second,DayOfWeek:integer;
  8. begin
  9.   GetTime(year,month,day,hour,minute,second,DayOfWeek);
  10.   SaveAs(year-1900:2,'-',month:2,'-',day:2,
  11.          '/',hour:2,'-'minute:2,'-',second:2);
  12. end;
  13.  
  14.  
  15. macro 'Open with selection… [O]';
  16. begin
  17.   if nPics>0 then KillRoi; {Save Selection}
  18.   Open('');                {Prompt for file name}
  19.   RestoreROI;              {Transfer selection to new window}
  20. end;
  21.  
  22.  
  23. macro 'Save All…';
  24. {
  25. Saves all currently open images in a folder using '001', '002', etc.
  26. as the file names. The save file dialog box will be displayed once
  27. (and only once) so that you can specify the folder to save the files in.
  28. Leave the file name blank(e.g. SaveAs('')) to get a dialog box for each file.
  29. }
  30. var
  31.   n:integer;
  32. begin
  33.   RequiresVersion(1.45);
  34.   for n:=1 to nPics do begin
  35.     SelectPic(n);
  36.     SaveAs(n:3);
  37.     {Export(n:3);}
  38.   end;
  39. end;
  40.  
  41.  
  42. macro 'Import FITS…';
  43. {
  44. Imports 8 and 16-bit FITS images. Refer to "FITS:A Flexible Image
  45. Transport System", Astronomy and Astrophysics Supplement
  46. Series 44, 1981, 363-370.
  47. }
  48. var
  49.   width,height,offset,HdrPid:integer;
  50.   recsize,maxrecs,maxlines,loc,i,line:integer;
  51.   BitPix,str:string;
  52. begin
  53.   RequiresVersion(1.52);
  54.   recsize:=2880;
  55.   maxrecs:=10; {Must be increased to handle headers longer than 360 lines.}
  56.   maxlines:=(recsize*maxrecs)/80;
  57.   width:=recsize; 
  58.   height:=maxrecs;
  59.   offset:=0;
  60.   SetImport('8-bit'); 
  61.   SetCustom(width,height,offset);
  62.   Import(''); {Read in header as an image, prompting for the file name.}
  63.   HdrPid:=PidNumber;
  64.   BitPix:=Concat(chr(GetPixel(108,0)),chr(GetPixel(109,0)));
  65.   if (BitPix<>' 8') and (BitPix<>'16') then begin
  66.     PutMessage('This macro only reads 8 and 16-bit FITS files');
  67.     SelectPic(HdrPid);
  68.     Dispose;
  69.     exit;
  70.   end;
  71.   str:=concat(chr(GetPixel(266,0)), chr(GetPixel(267,0)),
  72.     chr(GetPixel(268,0)), chr(GetPixel(269,0)));
  73.   width:=StringToNum(str);
  74.   str:=concat(chr(GetPixel(346,0)), chr(GetPixel(347,0)),
  75.     chr(GetPixel(348,0)), chr(GetPixel(349,0)));
  76.   height:=StringToNum(str);
  77.   loc:=0;
  78.   line:=0;
  79.   repeat
  80.     str:='';
  81.     for i:=1 to 3 do begin
  82.        str:=concat(str,chr(GetPixel(loc mod recsize, loc div recsize)));
  83.        loc:=loc+1;
  84.     end;
  85.     loc:=loc+77; {Skip to end of line}
  86.     line:=line+1;
  87.   until (line>=maxlines) or (str='END');
  88.   SelectPic(HdrPid);
  89.   Dispose;
  90.   offset:=recsize+recsize*((line*80) div recsize);
  91.   if BitPix=' 8'
  92.     then SetImport('8-bit')
  93.     else SetImport('16-bit Signed; Calibrate; Autoscale');
  94.   SetCustom(width,height,offset);
  95.   Import('');  {No prompt this time; Import remembers the name.}
  96.   if BitPix=' 8' then Invert;
  97.   FlipVertical;
  98. end;
  99.  
  100. macro 'Display FITS Header…';
  101. var
  102.   i,j,loc:integer;
  103.   HdrPid,RecordSize,maxlines,line:integer;
  104.   MaxRecords:integer;
  105.   wname,str:string;
  106. begin
  107.   RequiresVersion(1.53);
  108.   RecordSize:=2880;
  109.   MaxRecords:=10;
  110.   maxlines:=(RecordSize*MaxRecords)/80;
  111.   SetImport('8-bit'); 
  112.   SetCustom(RecordSize,10,0);
  113.   Import(''); {Read in header as an image, prompting for the file name.}
  114.   HdrPid:=PidNumber;
  115.   SetFont('Monaco');
  116.   SetFontSize(9);
  117.   wname:=concat(WindowTitle,' Header');
  118.   NewTextWindow(wname,500,500);
  119.   loc:=0;
  120.   line:=1;
  121.   repeat
  122.     ChoosePic(HdrPid);
  123.     str:='';
  124.     for j:=1 to 80 do begin
  125.        str:=concat(str,chr(GetPixel(loc mod RecordSize, loc div RecordSize)));
  126.        loc:=loc+1;
  127.     end;
  128.     SelectWindow(wname);
  129.     writeln(str);
  130.     line:=line+1;
  131.   until (line>maxlines) or (pos('END',str)=1);
  132.   SelectPic(HdrPid);
  133.   Dispose;
  134.  end;
  135.  
  136.  
  137. macro 'Import Image TIFF File…';
  138. {
  139. As an example of how to import a foreign file format, this macro reads
  140. the TIFF files created by Image. The format of an Image TIFF file
  141. is described in Appendix E of the Image manual.
  142. }  
  143. var
  144.   width,height,offset:integer;
  145. begin
  146.   width:=768; 
  147.   height:=1;
  148.   offset:=0;
  149.   SetImport('8-bit'); 
  150.   SetCustom(width,height,offset);
  151.   Import(''); {Read in header as an image, prompting for the file name.}
  152.   if not ((GetPixel(0,0)=77) and (GetPixel(0,0)=77)) then begin  {'MM'}
  153.     PutMessage('This is not a TIFF file.');
  154.     SelectPic(nPics); Dispose;
  155.     exit;
  156.   end;
  157.   width := (GetPixel(30,0)*256) + GetPixel(31,0);
  158.   height := (GetPixel(42,0)*256) + GetPixel(43,0);
  159.   SelectPic(nPics);  {The ID of the last window opened is equal to nPics.}
  160.   Dispose;
  161.   offset:=768;
  162.   SetCustom(width,height,offset);
  163.   Import('');  {No prompt this time; Import remembers the name.}
  164. end;
  165.  
  166.  
  167. macro 'Import Multiple Images per File…';
  168. {
  169. Imports a series of 256x256 images contained in a single file, in this
  170. case an NIH Image stack with an arbitrary number of 256x256 slices.
  171. }
  172. var
  173.   offset,i,PicSize,HdrSize,width,height:integer;
  174. begin
  175.   HdrSize:= 768;
  176.   width:= 256;
  177.   height:=256;
  178.   PicSize:=width*height;
  179.   offset:=HdrSize;
  180.   SetImport('8-bit');
  181.   for I:=1 to 100 do begin  {Macro will terminate at eof}
  182.     SetCustom(width,height,offset);
  183.     Import('');
  184.     offset:=offset+PicSize;
  185.   end;
  186. end;
  187.  
  188.  
  189. macro 'Import 3D PET…';
  190. var
  191.   HdrSize,width,height:integer;
  192. begin
  193.   HdrSize:= 0;
  194.   width:= 128;
  195.   height:=128;
  196.   SetImport('8-bit');
  197.   SetCustom(width, height, HdrSize, 100);
  198.   Import('');
  199. end;
  200.  
  201.  
  202. macro 'Convert Files…';
  203. {
  204. Converts a set of raw data files(all in the same folder) with names
  205. in the form raw.001, raw.002, etc to TIFF or PICT.  As long as the
  206. converted files are saved in the same folder, you should
  207. only see two file dialog boxes(one for the first Import and one for
  208. the first SaveAs).
  209. }
  210. Var
  211.   i,nFiles:integer;
  212. begin
  213.   nFiles:=GetNumber('Number of files:',5);
  214.   for i:=1 to nFiles do begin
  215.     Import('raw.',i:3);
  216.     SetPicName('file',i:3);
  217.     SaveAs;
  218.     Dispose;
  219.   end;
  220. end;
  221.  
  222.  
  223. macro 'Import IPLab File';
  224. var
  225.    width,height,offset:integer;
  226. begin
  227.    width:=100; 
  228.    height:=1;
  229.    offset:=0;
  230.    SetImport('8-bit'); 
  231.    SetCustom(width,height,offset);
  232.    Import(''); {Read in header as an image, prompting for file name.}
  233.    width := (GetPixel(8,0)*256) + GetPixel(9,0);
  234.    height := (GetPixel(12,0)*256) + GetPixel(13,0);
  235.    Dispose;  
  236.    offset:=2120;  {The IPLab offset}
  237.    SetImport('16-bit Signed; Calibrate; Autoscale');
  238.    SetCustom(width,height,offset);
  239.    Import('');  {No prompt this time; Import remembers the name.}
  240. end;
  241.  
  242.  
  243. procedure ShowBioRadInfo(InfoOffset: integer);
  244. {Displays the contents of the 480(?) byte header at}
  245. {the end of Biorad MRC 600 Z Series files.}
  246. var
  247.   MaxInfoSize,offset:integer;
  248.   ch, title:string;
  249. begin
  250.   MaxInfoSize:=480;
  251.   SetCustom(MaxInfoSize, 1, InfoOffset);
  252.   SetImport('8-bit'); {Don't invert}
  253.   Import('');
  254.   GetRow(0,0,MaxInfoSize);
  255.   Dispose;
  256.   SaveState;
  257.   title := concat(WindowTitle, '.Info');
  258.   NewTextWindow(title, 450, 150);
  259.   SetCursor('Watch');
  260.   SetFont('Monaco');
  261.   SetFontSize(12);
  262.   for i:=0 to MaxInfoSize-1 do begin
  263.     offset:=i mod 96;
  264.     if offset=0 then writeln;
  265.     ch:=chr(LineBuffer[i]);
  266.     if (offset=2) and (ord(ch)=0) then exit;
  267.     if (offset>=16) and (offset<=95) and (ord(ch)>=32) and (ord(ch)<=126)
  268.       then write(ch);
  269.   end;
  270.   RestoreState;
  271. end;
  272.  
  273.  
  274. macro 'Import Biorad MRC 600 Z Series…';
  275. {
  276. Imports a Z series(multiple images per file) from a Biorad MRC 600
  277. confocal microscope.  The width, height and number of images are
  278. extracted from the first 3 16-bit word in the 76 byte header and
  279. the file name is extracted from bytes 18-23 of the header. This macro
  280. does not read merged pseudocolored BioRad files. Note that the Undo
  281. and Clipboard buffers must be set to 384K to work with the typical
  282. 768x512 Biorad images.
  283. }
  284. var
  285.   width,height,nImages,offset,hdrsize,i,start,picsize:integer;
  286. begin
  287.   RequiresVersion(1.50);
  288.   width:=512; 
  289.   height:=1;
  290.   offset:=0;
  291.   SetImport('8-bit'); 
  292.   SetCustom(width,height,offset);
  293.   Import(''); {Read header}
  294.   GetPicSize(width,height);
  295.   if (width<>512) or (height<>1) then begin
  296.     Dispose;
  297.     PutMessage('Please to not change width, height, etc. in the Import dialog box.');
  298.     exit;
  299.   end;
  300.   width:=GetPixel(0,0)+GetPixel(1,0)*256;
  301.   height:=GetPixel(2,0)+GetPixel(3,0)*256;
  302.   nImages:=GetPixel(4,0)+GetPixel(5,0)*256;
  303.   Dispose;
  304.   hdrsize:= 76;
  305.   picsize:=width*height;
  306.   if (width<128) or (width>2048) or (height<128) or (height>2048) or (nImages<1) or (nImages>256) then begin
  307.     PutMessage('This does not seem to be a Biorad MRC 600 Z Series file.');
  308.     exit;
  309.   end;
  310.   start:=GetNumber('Starting image:',1);
  311.   offset:=HdrSize+(start-1)*PicSize;
  312.   SetImport('8-bit, Invert');
  313.   SetCustom(width,height,offset,nimages);
  314.   Import('');
  315.   ShowBioRadInfo(HdrSize + nImages * width * height);
  316. end;
  317.  
  318.  
  319. macro 'Import from IBAS';
  320. var
  321.    width,height,offset:integer;
  322. begin
  323.    width:=128; 
  324.    height:=1;
  325.    offset:=0;
  326.    SetImport('8-bit'); 
  327.    SetCustom(width,height,offset);
  328.    Import(''); {Read in header as an image, prompting for file name.}
  329.    width := (GetPixel(7,0)*256) + GetPixel(6,0);
  330.    height := (GetPixel(9,0)*256) + GetPixel(8,0);
  331.    Dispose(nPics);  {The ID of the last window opened = nPics.}
  332.    offset:=128;  {The IBAS offset}
  333.    SetImport('8-bit; Calibrate; Autoscale');
  334.    SetCustom(width,height,offset);
  335.    Import('');  {No prompt this time; Import remembers the name.}
  336.    Invert
  337.    SetScaling ('Bilinear');
  338.    SetScaling ('New Window');
  339.    ScaleAndRotate (0.80, 1.0, 0);
  340. end;
  341.  
  342.  
  343. macro 'Import 64x64x64x16-bit SPECT Image…';
  344. {Imports a 64x64x64x16-bit headerless SPECT image into a stack.}
  345. var
  346.   width,height,nImages,hdrsize:integer;
  347. begin
  348.   RequiresVersion(1.50);
  349.   width:=64;
  350.   height:=64;
  351.   nImages:=64;
  352.   HdrSize:= 0;
  353.   SetImport('16-bit Unsigned, Swap Bytes');
  354.   {SetImportMinMax(0,2500);} {Uncomment to fix scale}
  355.   SetCustom(width,height,HdrSize,nImages);
  356.   Import('');
  357.  end;
  358.  
  359.  
  360. macro 'Import 8-bit 3D Image…';
  361. var
  362.   width,height,offset,nImages:integer;
  363. begin
  364.   RequiresVersion(1.50);
  365.   width:=GetNumber('Width:',256);
  366.   height:=GetNumber('Height:',256);
  367.   nImages:=GetNumber('Depth(number of slices):',128);
  368.   offset:=GetNumber('Offset(header size):',0);
  369.   SetImport('8-bit'); 
  370.   SetCustom(width,height,offset,nImages);
  371.   Import('');
  372. end;
  373.  
  374.  
  375. macro 'Open with scale set to 100 pixels/mm [S]';
  376. {Example of a way to open images and have the}
  377. {spatial scale always set the same way.}  
  378. begin
  379.   Open('');           {or Import('')}
  380.   SetScale(100,'mm'); {Change as needed}
  381. end;
  382.  
  383.  
  384. macro 'Load Synergy Image';
  385. begin
  386.    SetImport('8-bit'); 
  387.    SetCustom(512,480,16384);
  388.    Import('');
  389.    ChangeValues(0,0,1);
  390.    ChangeValues(255,255,254);
  391.    SetPalette('Rainbow');
  392. end;
  393.  
  394.  
  395. macro 'Import Siemens 3D MRI…';
  396. begin
  397.   RequiresVersion(1.50);
  398.   SetImport('16-bit Signed, Swap Bytes');
  399.   {SetImportMinMax(0,3000);} {Remove comments to fix scale}
  400.   SetCustom(256,256,0,127);
  401.   Import('');
  402. end;
  403.  
  404.  
  405. macro 'Import LUT…';
  406. {Imports a 256 x 3 x 8-bit look-up table located 'offset'
  407.  bytes from the beginning of a file. Use an offset of 32 for
  408.  LUTs created using Image's Save As command and an
  409.  offset of 0 for Exported LUTs.}
  410. }  
  411. var
  412.   offset,i:integer;
  413. begin
  414.   offset:=0; {Use 32 for LUTs created using Save As}
  415.   SetImport('8-bit'); 
  416.   SetCustom(256,3,offset);
  417.   Import(''); {Read LUT as an image}
  418.   for i:=0 to 255 do begin
  419.     RedLut[i]:=GetPixel(i,0);
  420.     GreenLut[i]:=GetPixel(i,1);
  421.     BlueLut[i]:=GetPixel(i,2);
  422.   end;
  423.   UpdateLUT;
  424. end;
  425.  
  426. macro 'Open List of Files…';
  427. var
  428.   width,height:integer;
  429.   name,ch:string;
  430. begin
  431.   width:=256;
  432.   height:=3;
  433.   SetCustom(width,height,0);
  434.   Import('File List'); {Read text as an image}
  435.   repeat
  436.     name:='';
  437.     repeat
  438.        ch:=chr(GetPixel(CharLoc mod width,CharLoc div width));
  439.        if ch>=chr(32) then begin
  440.          name:=concat(name,ch);
  441.        end;
  442.        CharLoc:=CharLoc+1;
  443.      until (ch=13) or (CharLoc>=width*height);
  444.      ShowMessage(name);
  445.      wait(1);
  446.   until (name='') or (CharLoc>=width*height);
  447. end;
  448.  
  449. macro 'File processing test';
  450. begin
  451.   Open('hd400:images:image001');
  452.   Invert;
  453.   Save;
  454.   Close;
  455.   Open('hd400:images:image002');
  456.   Invert;
  457.   Save;
  458.   Close;
  459.   Open('hd400:images:image003');
  460.   Invert;
  461.   Save;
  462.   Close;
  463. end;
  464.  
  465. macro 'Batch Processing Example…';
  466. {
  467. Reads from disk and processes a set of images too large to
  468. simultaneously fit in memory. The image names names must be
  469. in the form 'image001', 'image002', ..., but this can be changed.
  470. }
  471. var
  472.   i:integer;
  473. begin
  474.   for i:=1 to 1000 do begin
  475.       open('image',i:3);
  476.      {process;}
  477.       save;
  478.       close;
  479.    end;
  480. end;
  481.  
  482.  
  483. macro 'Export Non-Rectangular ROI';
  484. var
  485.   left,top,width,height:integer;
  486.   pid1,pid2:integer;
  487. begin
  488.   GetRoi(left,top,width,height);
  489.   if width=0 then begin
  490.      PutMessage('Non-rectangular selection required.');
  491.      exit;
  492.   end;
  493.   pid1:=PidNumber;
  494.   SetNewSize(width,height);
  495.   MakeNewWindow('Temp');
  496.   pid2:=PidNumber;
  497.   SelectPic(pid1);
  498.   Copy;
  499.   SelectPic(pid2);
  500.   Paste;
  501.   Export; {or SaveAs}
  502. end;
  503.  
  504.  
  505. macro 'Import MCID…';
  506. begin
  507.   SetImport('MCID'); 
  508.   Import(''); 
  509. end;
  510.  
  511.  
  512. macro 'Import Series of Files…';
  513. Var
  514.   i,first,last:integer;
  515.   width, height, offset:integer;
  516. begin
  517.   width := 512;
  518.   height := 512;
  519.   offset := 0;
  520.   first:=round(GetNumber('First file number:',1));
  521.   last:=round(GetNumber('Last file number:',999));
  522.   SetImport('Custom; 8-bits; Invert');
  523.   SetCustom(width,height,offset);
  524.   for i:=first to last do
  525.     Import('IMG',i:4, '.CASTRO11');
  526. end;
  527.  
  528.  
  529.  
  530. macro 'File Paths Demo';
  531. {Demonstrates the new GetPath() and GetFileInfo() macro functions.}
  532. var
  533.   wPath, sPath, pPath: string;
  534.   name, FullPath, FileType, folder: string;
  535.   FileSize: integer;
  536. begin
  537.   name := WindowTitle; {Grab name before before opening window} 
  538.   wPath := GetPath('window'); {Grab path before before opening window}
  539.   sPath := GetPath('startup');
  540.   pPath := GetPath('pref');
  541.   SaveState;
  542.   SetFont('Geneva');
  543.   SetFontSize(12);
  544.   NewTextWindow('Paths Demo');
  545.  
  546.   if wPath = '' then begin
  547.      writeln('No opened image or text window');
  548.      writeln
  549.   end else begin
  550.      writeln;
  551.      FullPath := concat(wPath, name);
  552.      writeln('Active window path = "', FullPath, '"');
  553.      GetFileInfo(FullPath, FileType, FileSize);
  554.      writeln('File type = "', FileType, '"');
  555.      writeln('File size = ', FileSize:1);
  556.      writeln;
  557.   end;
  558.   writeln('Startup path = "', sPath, '"');
  559.   writeln('Preferences path = "', pPath, '"');
  560.  
  561.         writeln;
  562.   name := 'Image Prefs';
  563.   FullPath := concat(GetPath('pref'), name);
  564.   GetFileInfo(FullPath, FileType, FileSize);
  565.   if FileSize < 0 then
  566.      writeln('"', name, '" not found in Preferences folder')
  567.   else
  568.      writeln('The file "', name,'" (type="', FileType,
  569.      '", size=', FileSize:1, ') was found in Preferences folder.');
  570.  
  571.   writeln;
  572.   name := 'image1.tif';
  573.   folder := 'Images';
  574.   FullPath := concat(GetPath('startup'), folder, ':', name);
  575.   GetFileInfo(FullPath, FileType, FileSize);
  576.   if FileSize < 0 then
  577.      writeln('The file "', name, '" was not found in the "',
  578.        folder, '" folder in NIH Image folder.')
  579.   else begin
  580.                     writeln('Opening the file "', FullPath, '"');
  581.      open(FullPath);
  582.   end;
  583.  
  584.   RestoreState;
  585. end;
  586.  
  587.  
  588. function GetName(ListName: string; i: integer): string;
  589. {Returns the the ith line from a text file that has been
  590. read into a one line image named 'ListName'.}
  591. var
  592.    loc, ch: integer;
  593.    name: string;
  594. begin
  595.   SelectWindow(ListName);
  596.   loc := -1;
  597.   for i := 2 to i do
  598.      repeat
  599.        loc := loc + 1;
  600.        ch := GetPixel(loc, 0)
  601.      until ch < 32; {return or linefeed}
  602.   name := '';
  603.   repeat
  604.      loc := loc + 1;
  605.      ch := GetPixel(loc, 0);
  606.      if ch >= 32 then
  607.        name := concat(name, chr(ch));
  608.   until ch < 32;
  609.   GetName := name;
  610. end;
  611.  
  612.  
  613. Macro 'Open Files From List...';
  614. {Opens a series of files from a list stored in a text file.}
  615. var
  616.    path, FileType, ListName, ImageName: string;
  617.    FileSize, i: integer;
  618. begin
  619.   ListName := 'file-list.txt';
  620.   path := concat(GetPath('startup'), ListName);
  621.   GetFileInfo(path, FileType, FileSize);
  622.   if FileSize < 0 then begin
  623.      PutMessage('The file "', ListName, '" could not be found in the same folder as NIH image.');
  624.      exit;
  625.   end;
  626.   SetImport('8-bit');
  627.   SetCustom(FileSize, 1, 0);
  628.   Import(path);
  629.   for i := 1 to 1000 do begin
  630.     ImageName := GetName(ListName, i);
  631.     if ImageName = '' then begin
  632.         SelectWindow(ListName);
  633.         close;
  634.         exit;
  635.      end;
  636.      open(ImageName);
  637.      {process image}
  638.      wait(1);
  639.      close;
  640.   end;
  641. end;
  642.  
  643.